home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / select.com / SELECT1.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-12-11  |  16.6 KB  |  447 lines
  1. DECLARE SUB SelectField (ColSpace%, ColWidth%, DispArray$(), Msg$, MsgRow%, NumCols%, NumSelections%, NumRows%, Selection%, StartCol%, StartRow%, Title$, TitleRow%)
  2. DECLARE SUB DisplayScreen (ColSpace%, ColWidth%, Msg$, MsgRow%, NumCols%, NumRows%, NumSelections%, RowOffSet%, StartCol%, Title$, TitleRow%)
  3.  
  4.       'dim to total # of fields
  5.       DIM SHARED DispArray$(48)
  6.       COMMON SHARED ForeNorm%, BackNorm%, ForeHi%, BackHi%
  7.  
  8.       'NOTE: it is your responsibility to layout the screen in such
  9.       'a way so as to prevent wraparound...selectfield does not do
  10.       'any checking for this-make sure that your screens are
  11.       'rectanguar or square (every column has same # of rows and every
  12.       'row has same # of columns) and that they will fit into an 80 x 24 space
  13.       NumRows% = 12   'number of lines per column
  14.       NumCols% = 4     'number of columns per line
  15.       NumSelections% = NumRows% * NumCols%
  16.       ColWidth% = 8   'width of each column(field)
  17.       ColSpace% = 12  'spacing between columns
  18.       StartRow% = 5    'row # for first field
  19.       StartCol% = 6    'col # for first field-adjust to center the display
  20.       Title$ = "  USER SELECTION TEST  "
  21.       TitleRow% = 2
  22.       Msg$ = " Use Arrows,TAB,HOME or END To Move Highlight Bar, <ENTER> To Make Selection "
  23.       MsgRow% = 22
  24.  
  25.       'normal colors
  26.       ForeNorm% = 3
  27.       BackNorm% = 0
  28.       'highlight colors
  29.       ForeHi% = 4
  30.       BackHi% = 7
  31.  
  32.       'assign the desired display options to display string array-can
  33.       'do it in a for next loop, or READ/DATA statements, etc
  34.       DispArray$(1) = "CHOICE01"
  35.       DispArray$(2) = "CHOICE02"
  36.       DispArray$(3) = "CHOICE03"
  37.       DispArray$(4) = "CHOICE04"
  38.       DispArray$(5) = "CHOICE05"
  39.       DispArray$(6) = "CHOICE06"
  40.       DispArray$(7) = "CHOICE07"
  41.       DispArray$(8) = "CHOICE08"
  42.       DispArray$(9) = "CHOICE09"
  43.       DispArray$(10) = "CHOICE10"
  44.       DispArray$(11) = "CHOICE11"
  45.       DispArray$(12) = "CHOICE12"
  46.       DispArray$(13) = "CHOICE13"
  47.       DispArray$(14) = "CHOICE14"
  48.       DispArray$(15) = "CHOICE15"
  49.       DispArray$(16) = "CHOICE16"
  50.       DispArray$(17) = "CHOICE17"
  51.       DispArray$(18) = "CHOICE18"
  52.       DispArray$(19) = "CHOICE19"
  53.       DispArray$(20) = "CHOICE20"
  54.       DispArray$(21) = "CHOICE21"
  55.       DispArray$(22) = "CHOICE22"
  56.       DispArray$(23) = "CHOICE23"
  57.       DispArray$(24) = "CHOICE24"
  58.       DispArray$(25) = "CHOICE25"
  59.       DispArray$(26) = "CHOICE26"
  60.       DispArray$(27) = "CHOICE27"
  61.       DispArray$(28) = "CHOICE28"
  62.       DispArray$(29) = "CHOICE29"
  63.       DispArray$(30) = "CHOICE30"
  64.       DispArray$(31) = "CHOICE31"
  65.       DispArray$(32) = "CHOICE32"
  66.       DispArray$(33) = "CHOICE33"
  67.       DispArray$(34) = "CHOICE34"
  68.       DispArray$(35) = "CHOICE35"
  69.       DispArray$(36) = "CHOICE36"
  70.       DispArray$(37) = "CHOICE37"
  71.       DispArray$(38) = "CHOICE38"
  72.       DispArray$(39) = "CHOICE39"
  73.       DispArray$(40) = "CHOICE40"
  74.       DispArray$(41) = "CHOICE41"
  75.       DispArray$(42) = "CHOICE42"
  76.       DispArray$(43) = "CHOICE43"
  77.       DispArray$(44) = "CHOICE44"
  78.       DispArray$(45) = "CHOICE45"
  79.       DispArray$(46) = "CHOICE46"
  80.       DispArray$(47) = "CHOICE47"
  81.       DispArray$(48) = "CHOICE48"
  82.  
  83.       'call routine to display choices and get user selection
  84.       CALL SelectField(ColSpace%, ColWidth%, DispArray$(), Msg$, MsgRow%, NumCols%, NumSelections%, NumRows%, Selection%, StartCol%, StartRow%, Title$, TitleRow%)
  85.       COLOR ForeNorm%, BackNorm%, 0
  86.       CLS
  87.       'assign user selection and description string
  88.       UserChoice% = Selection%
  89.       'print choice
  90.       PRINT "Your Selection Was "; DispArray$(UserChoice%)
  91.  
  92.  END
  93.  
  94. SUB DisplayScreen (ColSpace%, ColWidth%, Msg$, MsgRow%, NumCols%, NumRows%, NumSelections%, RowOffSet%, StartCol%, Title$, TitleRow%)
  95. '
  96. '----------------------------------------------------------------------------
  97. '  Input    : Number of rows to be displayed in NumRows%, number of columns
  98. '             in NumCols%, starting column # in StartCol%, string array
  99. '             containing selection strings to display in DispArray(x)
  100. '             (shared array), number of selections to display in
  101. '             NumSelections%, spacing between columns in ColSpace%, width of
  102. '             each column in ColWidth%, message to display in Msg$, row on
  103. '             which to display message in MsgRow%, color numbers in ForeHi%
  104. '             and BackHi% (shared scalars)
  105. '  Process  : Displays the selections and user message
  106. '  Output   : User selection in Selection%
  107. '  Coupling : Called by SelectField
  108. '             Calls no subs or functions
  109. '
  110. '----------------------------------------------------------------------------
  111. '
  112.  
  113.    'display the selector screen & highlight initial choice
  114.    FOR I% = 1 TO (NumSelections% / NumCols%)
  115.       'col 2 gets us inside the left side of the border (if one)
  116.       LOCATE I% + RowOffSet%, StartCol%
  117.  
  118.       'assign current ctr val-will inc by number of rows
  119.       Ctr% = I%
  120.  
  121.       FOR ColCtr% = 1 TO NumCols%
  122.  
  123.          'calculate value for TAB function which follows
  124.          A = ((((ColCtr% - 1) * ColWidth%) + StartCol%) + (ColCtr% - 1) * ColSpace%)
  125.          PRINT TAB(A); DispArray$(Ctr%);
  126.          Ctr% = Ctr% + NumRows%
  127.  
  128.       NEXT ColCtr%
  129.  
  130.       'done displaying line-go to next line
  131.       PRINT
  132.  
  133.    NEXT I%
  134.  
  135.    COLOR ForeHi%, BackHi%, 0
  136.  
  137.    LOCATE TitleRow%, ((80 - LEN(Title$)) / 2)
  138.    PRINT Title$
  139.    'print message line
  140.    LOCATE MsgRow%, 3
  141.    PRINT Msg$
  142.  
  143. END SUB
  144.  
  145. SUB SelectField (ColSpace%, ColWidth%, DispArray$(), Msg$, MsgRow%, NumCols%, NumSelections%, NumRows%, Selection%, StartCol%, StartRow%, Title$, TitleRow%)
  146. '
  147. '----------------------------------------------------------------------------
  148. '  Input    : Number of rows to be displayed in NumRows%, number of columns
  149. '             in NumCols%, width of each column in ColWidth%, starting line
  150. '             number in StartRow%, starting column # in StartCol%, string
  151. '             array containing selection strings to display in DispArray(x),
  152. '             number of selections to display in NumSelections%, spacing
  153. '             between columns in ColSpace%, message to display in Msg$, row
  154. '             on which to display message in MsgRow%
  155. '  Process  : Allows user to cycle thru all possible selections displayed
  156. '             until carriage return is pressed.
  157. '  Output   : User selection in Selection%
  158. '  Coupling : Called by Main
  159. '             Calls DisplayScreen   
  160. '
  161. '----------------------------------------------------------------------------
  162. '
  163. '  Define names similar to keyboard names with their equivalent key codes.
  164.    ENTER = 13
  165.    RIGHTAB = 9
  166.    LEFTAB = 15
  167.    DNARROW = 80
  168.    UPARROW = 72
  169.    LEFT = 75
  170.    RIGHT = 77
  171.    HOME = 71
  172.    ENDK = 79
  173.    PGDN = 81
  174.    PGUP = 73
  175.  
  176.    RowOffSet% = StartRow% - 1
  177.    ' Set the row and column index ptrs to 1,1
  178.    Row% = 1
  179.    Col% = 1
  180.    'set initial selection # to 1
  181.    Selection% = 1
  182.  
  183.    'display whole screen in normal colors
  184.    COLOR ForeNorm%, BackNorm%, 0
  185.    CLS
  186.  
  187.    CALL DisplayScreen(ColSpace%, ColWidth%, Msg$, MsgRow%, NumCols%, NumRows%, NumSelections%, RowOffSet%, StartCol%, Title$, TitleRow%)
  188.  
  189.    'we will high lite 1st selection when menu comes up, row 1 col 1
  190.    HiLiteRow% = Row% + RowOffSet%
  191.    HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  192.    GOSUB HIGHLIGHT
  193. '
  194.  
  195.    'Top of "Do <Get User Selection> Until User Hits Enter Key" loop
  196.    DO
  197.       'Top of "Do <Get Key> Until User Hits a Key" loop
  198.       DO
  199.  
  200.          Ky$ = INKEY$
  201.          'can't do ASC fn on zero, so trap zero
  202.          IF LEN(Ky$) > 0 THEN
  203.             Ky% = ASC(RIGHT$(Ky$, 1))
  204.          END IF
  205.  
  206.       LOOP UNTIL LEN(Ky$) > 0
  207.  
  208.       SELECT CASE Ky%
  209.  
  210.       '****************    DOWN  ARROW  PRESSED        ********************
  211.  
  212.          CASE IS = DNARROW
  213.               'un-highlight the old field
  214.                NormRow% = Row% + RowOffSet%
  215.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  216.  
  217.                GOSUB NORMAL
  218.  
  219.                'did we advance or rollback to top ?
  220.                IF Row% = NumRows% THEN
  221.                   'when a col rollup occurs, the value of Selection%
  222.                   'depends upon which col,we are currently in
  223.                   Selection% = 1 + ((Col% - 1) * NumRows%)
  224.                   'we know that array ptr goes back to 1 on a col rollup
  225.                   Row% = 1
  226.                ELSE
  227.                   Selection% = Selection% + 1
  228.                   Row% = Row% + 1
  229.                END IF
  230.  
  231.                'highlight the next field
  232.                HiLiteRow% = Row% + RowOffSet%
  233.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  234.                GOSUB HIGHLIGHT
  235.  
  236.       '****************      UP  ARROW  PRESSED        ********************
  237.  
  238.            CASE IS = UPARROW
  239.               'un-highlight the old field
  240.                NormRow% = Row% + RowOffSet%
  241.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  242.                GOSUB NORMAL
  243.  
  244.                'did we backup 1 or wrapdown to bot of list ?
  245.                IF Row% = 1 THEN
  246.                   'when a col wrapdown occurs, the value of Selection%
  247.                   'is product of highest row # x col # we are now in
  248.                   Selection% = NumRows% * Col%
  249.                   'we know that array ptr goes back to numrows on a col wrapdn
  250.                   Row% = NumRows%
  251.                ELSE
  252.                   Selection% = Selection% - 1
  253.                   Row% = Row% - 1
  254.                END IF
  255.  
  256.                'highlight the next field
  257.                HiLiteRow% = Row% + RowOffSet%
  258.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  259.                GOSUB HIGHLIGHT
  260.  
  261.       '****************      LEFT  ARROW  PRESSED        ******************
  262.  
  263.            CASE IS = LEFT
  264.               'un-highlight the old field
  265.                NormRow% = Row% + RowOffSet%
  266.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  267.                GOSUB NORMAL
  268.  
  269.                'did we only backup 1 or wrap to right side of screen ?
  270.                IF Col% = 1 THEN
  271.                   'we wrapped to right side so col = largest col #
  272.                   Col% = NumCols%
  273.                   'when a col wrap to right occurs, the value of
  274.                   'Selection =  row# + product of (# col - 1) * # rows
  275.                   Selection% = Row% + ((NumCols% - 1) * NumRows%)
  276.                ELSE
  277.                   'dec selection by # of items in a col
  278.                   'and decrement col by 1
  279.                   Selection% = Selection% - NumRows%
  280.                   Col% = Col% - 1
  281.                END IF
  282.  
  283.                'highlight the next field
  284.                HiLiteRow% = Row% + RowOffSet%
  285.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  286.                GOSUB HIGHLIGHT
  287.  
  288.       '****************     RIGHT  ARROW  PRESSED        ******************
  289.  
  290.            CASE IS = RIGHT
  291.               'un-highlight the old field
  292.                NormRow% = Row% + RowOffSet%
  293.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  294.                GOSUB NORMAL
  295.  
  296.                'did we backup 1 or wrap to left side of screen ?
  297.                IF Col% = NumCols% THEN
  298.                   'since we wrapped to left side, col = 1 & row is same
  299.                   Col% = 1
  300.                   'when a col wrapleft occurs, the value of Selection%
  301.                   'is the same as the row # we are currently in
  302.                   Selection% = Row%
  303.                ELSE
  304.                   Selection% = Selection% + NumRows%
  305.                   Col% = Col% + 1
  306.                END IF
  307.  
  308.                'highlight the next field
  309.                HiLiteRow% = Row% + RowOffSet%
  310.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  311.                GOSUB HIGHLIGHT
  312.  
  313.       '****************     HOME KEY  PRESSED        ******************
  314.  
  315.            CASE IS = HOME
  316.               'un-highlight the old field
  317.                NormRow% = Row% + RowOffSet%
  318.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  319.                GOSUB NORMAL
  320.  
  321.                Row% = 1
  322.                Col% = 1
  323.                Selection% = 1
  324.  
  325.                'highlight the next field
  326.                HiLiteRow% = Row% + RowOffSet%
  327.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  328.                GOSUB HIGHLIGHT
  329.  
  330.       '****************     END KEY  PRESSED        ******************
  331.  
  332.            CASE IS = ENDK
  333.               'un-highlight the old field
  334.                NormRow% = Row% + RowOffSet%
  335.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  336.                GOSUB NORMAL
  337.  
  338.                Row% = NumRows%
  339.                Col% = NumCols%
  340.                Selection% = (NumSelections%)
  341.  
  342.                'highlight the next field
  343.                HiLiteRow% = Row% + RowOffSet%
  344.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  345.                GOSUB HIGHLIGHT
  346.  
  347.       '****************     RIGHT  TAB  PRESSED        ******************
  348.  
  349.            CASE IS = RIGHTAB
  350.               'un-highlight the old field
  351.                NormRow% = Row% + RowOffSet%
  352.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  353.                GOSUB NORMAL
  354.  
  355.                'did we backup 1 or wrapleft to right side of screen ?
  356.  
  357.                IF Col% = NumCols% AND Row% <> NumRows% THEN
  358.                   'we are wrapping to left side of screen but we are not
  359.                   'at the bottom yet, so increment row
  360.                   Row% = Row% + 1
  361.                   Col% = 1
  362.                   Selection% = Row%
  363.                ELSEIF Col% = NumCols% AND Row% = NumRows% THEN
  364.                   'we were at the bottom right corner, so go to home pos
  365.                   Row% = 1
  366.                   Col% = 1
  367.                   Selection% = 1
  368.                ELSE
  369.                   'we are moving 1 to the right only, no wrapping, row same
  370.                   Selection% = Selection% + NumRows%
  371.                   Col% = Col% + 1
  372.                END IF
  373.  
  374.                'highlight the next field
  375.                HiLiteRow% = Row% + RowOffSet%
  376.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  377.                GOSUB HIGHLIGHT
  378.  
  379.       '****************      LEFT  TAB  PRESSED        ******************
  380.  
  381.            CASE IS = LEFTAB
  382.               'un-highlight the old field
  383.                NormRow% = Row% + RowOffSet%
  384.                NormCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  385.                GOSUB NORMAL
  386.  
  387.                'did we backup 1 or wrapleft to right side of screen ?
  388.  
  389.                IF Col% = 1 AND Row% <> 1 THEN
  390.                   'we are wrapping to right side of screen but we are not
  391.                   'at the top yet, so decrement row & reset col to right
  392.                   Row% = Row% - 1
  393.                   Col% = NumCols%
  394.                   'back up selection #
  395.                   Selection% = Selection% + (((NumCols% - 1) * NumRows%) - 1)
  396.  
  397.                ELSEIF Col% = 1 AND Row% = 1 THEN
  398.                   'we were at the top left corner, so go to end position
  399.                   Row% = NumRows%
  400.                   Col% = NumCols%
  401.                   Selection% = NumSelections%
  402.                ELSE
  403.                   'we are moving 1 to the left only, no wrapping, row is same
  404.                   Selection% = Selection% - NumRows%
  405.                   Col% = Col% - 1
  406.                END IF
  407.  
  408.                'highlight the next field
  409.                HiLiteRow% = Row% + RowOffSet%
  410.                HiLiteCol% = ((((Col% - 1) * ColWidth%) + StartCol%) + (Col% - 1) * ColSpace%)
  411.                GOSUB HIGHLIGHT
  412.  
  413.            CASE ELSE
  414.  
  415.                IF Ky% <> ENTER THEN
  416.                   BEEP
  417.                END IF
  418.  
  419.         END SELECT
  420.  
  421.    LOOP UNTIL Ky% = ENTER
  422.  
  423.    GOTO Bottom
  424.  
  425. '----------------Normal & Highlight Routines-----------------
  426. NORMAL:
  427.  
  428.          'return highlighted field to normal
  429.          COLOR ForeNorm%, BackNorm%, 0
  430.          LOCATE NormRow%, NormCol%, 0
  431.          PRINT DispArray$(Selection%)
  432.          RETURN
  433.  
  434. HIGHLIGHT:
  435.  
  436.          'highlight the new field
  437.          COLOR ForeHi%, BackHi%, 0
  438.          LOCATE HiLiteRow%, HiLiteCol%, 0
  439.          PRINT DispArray$(Selection%)
  440.          RETURN
  441. Bottom:
  442.  
  443.     'Selection% now contains user choice
  444.  
  445. END SUB
  446.  
  447.